home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
SPACE 1
/
SPACE - Library 1 - Volume 1.iso
/
utilitys
/
51
/
stocks.bas
< prev
next >
Wrap
BASIC Source File
|
1986-10-19
|
42KB
|
788 lines
100 '********************** STOCK PERFORMANCE TRACKER ***********************
110 '************************* Version 1.2 06/17/86 *************************
120 '**************************** By Jim Luczak *****************************
130 dim st1(250),st2(250),pt(50),pt1(50),ud(50),mnt(36),plt%(15),dta(12)
140 a#=1114:plt%(1)=1792:plt%(2)=112:cn=0:cnt=1:cnt1=1:tb=42
150 width 75:fl$="Field = ":max=51:lcut=.01:hcut=999:hcut1=999999
160 form$="$$###.##":form1$="####.#_%":form2$="$$###,###,###.##"
170 b#=gb:gintin=peek(b#+8):bka=0:bkb=1911:bka1=1911:bkb1=0:bka2=112:bkb2=0
180 br1$="-Next":br2$="-Prior":br6$="-Quit":br8$="-Most Recent"
190 line$=string$(38,174):line$=line$+string$(37,175)
200 linep$=string$(71,45):line1$=string$(75,249)
210 '------------------------ RETRIEVE DATA FROM DISK ------------------------
220 GETDATA:
230 if peek(systab)=2 then restore MEDREZ else restore HIREZ
240 read j,cr,cr1,cr2,syt,vt,dth,dh,vh
250 for x=1 to 8:read bkc(x),bkd(x):next x
260 restore MTEXT:for x=1 to 36:read mnt(x):next x
270 restore TABSETTINGS:for x=1 to 8:read dtb(x):next x
280 for x=1 to 12:read dta(x):next x
290 on error goto 6900
300 close #1:fullw 2:clearw 2:tl$=" Stock Performance Tracker ":gosub DOTITLE
310 plt%(0)=bkc(7):plt%(3)=bkd(7):poke a#,varptr(plt%(0))
320 te=20:th=20:gosub TEFFECT:gosub THEIGHT:restore TITLEDAT:color 2,1,1
330 x1=21:for x=1 to 5:gotoxy x1/j,3:read tc:?chr$(tc):x1=x1+6:next x
340 x1=2:color 1,1,1
350 for x=1 to 11:gotoxy x1/j,7:read tc:?chr$(tc):x1=x1+6:next x
360 x1=14:color 3,1,1
370 for x=1 to 7:gotoxy x1/j,11:read tc:?chr$(tc):x1=x1+6:next x
380 te=0:th=dth:gosub TEFFECT:gosub THEIGHT
390 color 2,1,1:gotoxy 29/j,15:?"LOADING DATA":color 1,1,1:close #1
400 f$="index.dat":open "I",#1,f$:input #1,tax,cnt,cnt1
410 for x=1 to 50:input #1,pt(x),pt1(x):next x:close #1
420 GETDAT:on error goto 0
430 f$="stock.dat":open "R", #1,f$,49
440 f$="stock1.dat":open "R",#2,f$,48
450 f$="price.dat":open "R", #3,f$,8
460 f$="stock2.dat":open "R",#4,f$,60
470 field #1,20 as name$,5 as exch$,5 as rate$,8 as pch$,6 as share$,5 as fee$
480 field #2,8 as hi0$,8 as lo0$,8 as hi1$,8 as lo1$,8 as hi2$,8 as lo2$
490 field #3,2 as mo$,6 as price$
500 field #4,1 as own$,8 as date$,11 as abbr$,40 as comment$
510 goto MAINMENU
520 '--------------------------- DO TITLE STRING -----------------------------
530 DOTITLE:
540 title$=tl$:title$=chr$(32)+chr$(14)+chr$(15)+title$
550 title$=title$+chr$(14)+chr$(15)+chr$(32)+chr$(0)
560 poke gintin,peek(systab+8):poke gintin+2,2:s#=gintin+4
570 poke s#,varptr(title$):gemsys(105):return
580 '----------------------------- MENU SCREEN -------------------------------
590 MAINMENU:
600 on error goto 0:tl$=" Stock Performance Tracker "
610 gosub DOTITLE:clearw 2:hc=0:astp=0
620 plt%(0)=0:plt%(3)=1911:plt%(2)=112:poke a#,varptr(plt%(0))
630 color 3,1,1:gotoxy 21/j,2:?"Currently Tracking "cnt1-1" Stocks"
640 color 3,1,1:gotoxy 22/j,4:?"A":color 1,1,1
650 gotoxy 24/j,4:?" - ADD Stocks to listing"
660 color 3,1,1:gotoxy 22/j,6:?"B":color 1,1,1
670 gotoxy 24/j,6:?" - ADD Closing Prices"
680 color 3,1,1:gotoxy 22/j,8:?"C":color 1,1,1
690 gotoxy 24/j,8:?" - EDIT Stock Listing"
700 color 3,1,1:gotoxy 22/j,10:?"D":color 1,1,1
710 gotoxy 24/j,10:?" - LIST Stocks"
720 color 3,1,1:gotoxy 22/j,12:?"E":color 1,1,1
730 gotoxy 24/j,12:?" - DATA Sheets & Charts"
740 color 3,1,1:gotoxy 22/j,14:?"F":color 1,1,1
750 gotoxy 24/j,14:?" - End":color 3,1,1
760 gotoxy 22/j,16:?"Enter Choice ":color 1,1,1
770 mc=0:while mc=0:gotoxy 35/j,16:menu=inp(2)
780 if menu>70 then menu=menu-32
790 if menu <65 or menu>70 then mc=0:?chr$(7); else mc=1
800 wend:drc2=0:n$="":n1$="":n2$="":stk$="":stk1$="":stk2$=""
810 on menu -64 goto ADDSTOCK,ADDPRICE,EDITSTOCK,LISTSTOCK,DISPLAY,CLEANUP
820 '------------------------ ADD STOCKS TO TRACE ----------------------------
830 ADDSTOCK:on error goto 7250
840 fil=0:if cnt>=max then cnt=max:gosub CHECKSPACE
850 if fil=1 then goto MAINMENU
860 clearw 2:plt%(0)=bkc(3):plt%(3)=bkd(3):poke a#,varptr(plt%(0))
870 tl$=" ADD STOCKS TO TRACE ":gosub DOTITLE:tb=65:gosub PERCENTD
880 color 2,1,1:gotoxy 0,0:?"Q";:color 1,1,1:?" = QUIT"
890 line input"Enter Company NAME ",n1$
900 if n1$="Q" or n1$="q" then goto MAINMENU
910 sav=1:if left$(n1$,1)="*" then mid$(n1$,1,1)="\"
920 lset name$=n1$
930 line input"Listing Abbreviation ",n$:if len(n$)=0 then n$=n1$
940 lset abbr$=n$:gotoxy 44/j,3:?"|":gotoxy 0,3
950 line input"Comments ",n$:lset comment$=n$
960 line input"Exchange ",n$:lset exch$=n$
970 line input"Rating ",n$:if len(n$)=0 then n$="NR"
980 lset rate$=n$
990 DOHI0:gotoxy 0,6:line input"Current year HIGH ",n1$
1000 if len(n1$)=0 then n1$="1"
1010 n=val(n1$):if n<lcut or n>hcut then ?chr$(7);:goto DOHI0
1020 lset hi0$=n1$
1030 DOLO0:gotoxy 0,7:line input"Current year LOW ",n2$
1040 if len(n2$)=0 then n2$="1"
1050 n=val(n2$):if n<lcut or n>hcut then ?chr$(7);:goto DOLO0
1060 lset lo0$=n2$
1070 DOHI1:gotoxy 0,8:line input"Last year HIGH ",n3$
1080 if len(n3$)=0 then n3$=n1$
1090 n=val(n3$):if n<lcut or n>hcut then ?chr$(7);:goto DOHI1
1100 lset hi1$=n3$
1110 DOLO1:gotoxy 0,9:line input"Last year LOW ",n4$
1120 if len(n4$)=0 then n4$=n2$
1130 n=val(n4$):if n<lcut or n>hcut then ?chr$(7);:goto DOLO1
1140 lset lo1$=n4$
1150 DOHI2:gotoxy 0,10:line input"Two year ago HIGH ",n5$
1160 if len(n5$)=0 then n5$=n3$
1170 n=val(n5$):if n<lcut or n>hcut then ?chr$(7);:goto DOHI2
1180 lset hi2$=n5$
1190 DOLO2:gotoxy 0,11:line input"Two year ago LOW ",n6$
1200 if len(n6$)=0 then n6$=n4$
1210 n=val(n6$):if n<lcut or n>hcut then ?chr$(7);:goto DOLO2
1220 lset lo2$=n6$
1230 DOPR:gotoxy 0,12:line input"Purchase Price Per Share ",n$
1240 if len(n$)=0 then n$="1"
1250 n=val(n$):if n<lcut or n>hcut then ?chr$(7);:goto DOPR
1260 n1$=n$:lset pch$=n$:color 3,1,1
1270 gotoxy 28/j,12:?"Price Per 100 Shares = ";
1280 print using form2$;val(n$)*100;:?" ":mc=0:while mc=0:color 1,1,1
1290 DONR:gotoxy 0,13:line input"Number of SHARES ",n$
1300 if len(n$)=0 then n$="100"
1310 n=val(n$):if n<1 or n>hcut1 then ?chr$(7);:goto DONR
1320 color 3,1,1:gotoxy 28/j,13
1330 ?n$" Shares at";:? using form$;val(n1$);:?" =";
1340 ? using form2$;val(n1$)*val(n$);:?" "
1350 color 1,1,1:line input"# of Shares Correct ( Y/N ) ",ans$
1360 if ans$="Y" or ans$="y" then mc=1 else mc=0
1370 wend:lset share$=n$
1380 DOBR:gotoxy 0,15:line input"Brokerage FEE ( % ) ",n$
1390 if len(n$)=0 then n$=".02"
1400 n=val(n$):if n<=0 or n>.99 then ?chr$(7);:goto DOBR
1410 lset fee$=n$:gotoxy 0,16:line input"Do You Own This STOCK ( Y/N ) ",n$
1420 if len(n$)=0 or n$="N" or n$="n" then n$="N" else n$="Y"
1430 lset own$=n$:line input"Enter Date ( Q = Kill Entry ) ",n$
1440 if len(n$)=0 then n$="--/--/--"
1450 if n$="Q" or n$="q" then sav=0:goto MAINMENU
1460 lset date$=n$
1470 if cn>0 then gosub REUSE:goto MAINMENU
1480 put #1,cnt:put #2,cnt:put #4,cnt:pt(cnt)=0:pt1(cnt)=0
1490 cnt=cnt+1:cnt1=cnt1+1:goto MAINMENU
1500 '------------------------- ENTER CLOSING PRICE ---------------------------
1510 ADDPRICE:on error goto 7250
1520 clearw 2:plt%(0)=bkc(2):plt%(3)=bkd(2):poke a#,varptr(plt%(0))
1530 tl$=" ADD CLOSING PRICE ":gosub DOTITLE:tb=2:gosub PERCENTD
1540 color 2,1,1:gotoxy 20/j,2:?"1":color 1,1,1
1550 gotoxy 24/j,2:?"Enter Closing Price":color 2,1,1
1560 gotoxy 20/j,4:?"2":color 1,1,1
1570 gotoxy 24/j,4:?"Do Closing Price for NEXT Stock on List":color 2,1,1
1580 gotoxy 20/j,6:?"3":color 1,1,1
1590 gotoxy 24/j,6:?"Return to Main Menu":color 2,1,1
1600 gotoxy 20/j,8:?"Enter Choice ":color 1,1,1
1610 mc=0:while mc=0:gotoxy 35/j,6:menu=inp(2)
1620 if menu<49 or menu>51 then mc=0:?chr$(7); else mc=1
1630 wend:on menu-48 goto ENTERP,AUTOSTEP,MAINMENU
1640 AUTOSTEP:astp=1
1650 '........................... GET STOCK I.D. .............................
1660 ENTERP:
1670 gotoxy 15/j,10:line input"Enter Month ( 1 - 12 ) ",n2$
1680 if len(n2$)=0 then n2$=n1$:if len(n2$)=0 then ?chr$(7);:goto ENTERP
1690 mo=int(val(n2$)):if mo>12 or mo<1 then ?chr$(7);:goto ENTERP
1700 if astp then hc=hc+1:stk$=str$(hc):goto DOID
1710 gotoxy 15/j,10:line input"Enter Company Name or Stock Number ",stk$
1720 if len(stk$)=0 then stk$=str$(hc)
1730 DOID:gosub STOCKID:if hc>cnt or hc=0 then ?chr$(7);:goto ADDPRICE
1740 get #4,hc:get #1,hc:if pt(hc)=0 then pt(hc)=1:pt1(hc)=1
1750 if left$(name$,1)="*" then ?chr$(7);:goto ADDPRICE
1760 gotoxy 15/j,12:?"This is the ";:color 2,1,1:?pt(hc);:color 1,1,1
1770 ?" Quote for Stock # ";:color 3,1,1:?hc;:color 1,1,1:?" "abbr$
1780 if pt1(hc)=1 then goto ENTP
1790 prb=pt(hc)-1:if prb=0 then prb=250
1800 get #3,((hc-1)*250)+prb:m=((val(mo$)-1)*3)+1:prc=val(price$)
1810 gotoxy 15/j,14:?"Last Quote was in ";:color 2,1,1
1820 ?chr$(mnt(m));chr$(mnt(m+1));chr$(mnt(m+2));:color 1,1,1:?" At ";
1830 color 2,1,1:print using form$;prc:color 1,1,1
1840 ENTP:gotoxy 15/j,16:?"Enter Closing Price for "abbr$
1850 ENTP1:gotoxy 50/j,16:line input sp$:if len(sp$)=0 then goto MAINMENU
1860 sp1=val(sp$):if sp1<lcut or sp1>hcut then ?chr$(7);:goto ENTP1
1870 rn=(hc-1)*250:fn=rn+pt(hc):pt(hc)=pt(hc)+1:pt1(hc)=pt1(hc)+1
1880 if pt1(hc)>251 then pt1(hc)=251
1890 if pt(hc)>250 then pt(hc)=1:gosub INCHILO
1900 lset mo$ = n2$:lset price$=sp$:put #3,fn
1910 sav=1:astp=0:n1$=n2$:goto ADDPRICE
1920 '........................ INCREMENT HI / LO .............................
1930 INCHILO:
1940 p1=0:p2=9999:rn=((hc-1)*250)
1950 for i=1 to 250:get #3,rn+i:p=val(price$):if p>p1 then p1=p
1960 if p<p2 then p2=p
1970 next i:if p2<lcut then p2=lcut
1980 if p1>hcut then p1=hcut
1990 ph$=str$(p1):pl$=str$(p2)
2000 ph$=mid$(ph$,2,len(ph$)):pl$=mid$(pl$,2,len(pl$))
2010 get #2,hc:lset hi2$=hi1$:lset lo2$=lo1$:lset hi1$=hi0$:lset lo1$=lo0$
2020 lset hi0$=ph$:lset lo0$=pl$:put #2,hc:return
2030 '...................... SHOW PERCENT TO DECIMAL .........................
2040 PERCENTD:gotoxy 0,0
2050 ?tab(tb)"1/4= .25":?tab(tb)"1/2= .5":?tab(tb)"3/4= .75":?
2060 ?tab(tb)"1/8= .12":?tab(tb)"3/8= .37":?tab(tb)"5/8= .62"
2070 ?tab(tb)"7/8= .87":?
2080 ?tab(tb)"1/16= .06":?tab(tb)"3/16= .19":?tab(tb)"5/16= .31"
2090 ?tab(tb)"7/16= .44"
2100 ?tab(tb)"9/16= .56":?tab(tb)"11/16= .69":?tab(tb)"13/16= .81"
2110 ?tab(tb)"15/16= .94":return
2120 '---------------------------- LIST STOCKS -------------------------------
2130 LISTSTOCK:
2140 clearw 2:color 2,1,1:tl$=" STOCK LISTING ":gosub DOTITLE
2150 plt%(0)=bkc(5):plt%(3)=bkd(5):poke a#,varptr(plt%(0))
2160 gotoxy 26/j,4:color 2,1,1:?"S";:color 1,1,1:?" - List To SCREEN"
2170 gotoxy 26/j,6:color 2,1,1:?"P";:color 1,1,1:?" - List To PRINTER"
2180 gotoxy 26/j,8:color 2,1,1:?"F";:color 1,1,1:?" - Print Stock FORM"
2190 gotoxy 26/j,10:color 2,1,1:?"Q";:color 1,1,1:?" - Quit"
2200 mc=0:while mc=0:gotoxy 0,9:ans=inp(2)
2210 if ans=83 or ans=115 then ans=1:mc=1
2220 if ans=80 or ans=112 then ans=2:mc=1
2230 if ans=70 or ans=102 then ans=3:mc=1
2240 if ans=81 or ans=113 then ans=4:mc=1
2250 if mc=0 then ?chr$(7);
2260 wend:?:on ans goto DOSCREEN,DOPRINTER,DOFORM,MAINMENU
2270 '............................ LIST TO SCREEN ............................
2280 DOSCREEN:
2290 x2=1:gosub DOHEAD
2300 for x=1 to cnt-1:pa=pt(x)-1:if pa<1 then pa=250
2310 x1=((x-1)*250)+pa
2320 get #1,x:get #2,x:if x1>=1 then get #3,x1:n$=price$ else n$="0"
2330 if left$(name$,1)="*" then goto SKIP
2340 ?" "x;tab(10)name$;tab(34)rate$;tab(41)exch$;tab(46);
2350 hi=(val(hi0$)+val(hi1$)+val(hi2$))/3
2360 lo=(val(lo0$)+val(lo1$)+val(lo2$))/3
2370 n=val(n$):print using form$;hi;tab(55)lo;tab(65)n
2380 x2=x2+1:if x2>15 then x2=1:gosub MESSAGE:if x2<>16 then gosub DOHEAD
2390 SKIP:next x:if x2<>16 then gosub MESSAGE
2400 goto MAINMENU
2410 MESSAGE:color 2,1,1:?"Press Any Key To Continue ( Q = Quit )";
2420 color 1,1,1:?chr$(7);:a=inp(2):if a=81 or a=113 then x=cnt-1:x2=16
2430 return
2440 '............................. DO HEADER .................................
2450 DOHEAD:
2460 clearw 2:?:color 3,1,1:gotoxy 0,0:?"STOCK #";
2470 ?tab(15)"COMPANY NAME"tab(33)"RATING"tab(41)"EXNG"tab(48);
2480 ?"AVG HI"tab(57)"AVG LO"tab(66)"LAST QUOTE":gotoxy 0,1
2490 color 1,1,1:?line$:return
2500 '........................... LIST TO PRINTER ............................
2510 DOPRINTER:
2520 clearw 2:color 1,1,1:gotoxy 31/j,9:?"PRINTING"
2530 lprint tab(35)"STOCK LISTING":lprint
2540 lprint"STOCK #"tab(15)"COMPANY NAME"tab(33)"RATING"tab(41)"EXNG"tab(48);
2550 lprint"AVG HI"tab(58)"AVG LO"tab(67)"LAST":lprint linep$
2560 for x=1 to cnt-1:pa=pt(x)-1:if pa<1 then pa=250
2570 x1=((x-1)*250)+pa
2580 get #1,x:get #2,x:if x1>=1 then get #3,x1:n$=price$ else n$="0"
2590 if left$(name$,1)="*" then goto SKIP1
2600 lprint" "x;tab(10)name$;tab(34)rate$;tab(41)exch$;tab(46);
2610 hi=(val(hi0$)+val(hi1$)+val(hi2$))/3
2620 lo=(val(lo0$)+val(lo1$)+val(lo2$))/3
2630 n=val(n$):lprint using form$;hi;tab(55)lo;tab(64)n
2640 SKIP1:next x:for x=1 to 62-(cnt1-1):lprint:next x
2650 goto MAINMENU
2660 '........................... PRINT STOCK FORM ...........................
2670 DOFORM:
2680 clearw 2:color 1,1,1:gotoxy 31/j,9:?"PRINTING"
2690 gosub DOFORMHEAD:for x=1 to cnt-1:get #1,x:get #4,x
2700 if left$(name$,1)="*" then goto SKIPF
2710 lprint x;tab(5)abbr$tab(19)exch$" "own$" |"tab(36)"|"tab(45)"|"tab(54);
2720 lprint"|"tab(64)"|":lprint linep$:fx=fx+1
2730 if fx>30 then lprint:lprint:lprint:lprint:gosub DOFORMHEAD
2740 SKIPF:next x:for x=1 to 66-(fx*2):lprint:next x
2750 goto MAINMENU
2760 DOFORMHEAD:fx=1
2770 lprint" ID NAME";tab(19)"EXCH"tab(31)"1"tab(40)"2"tab(49)"3"tab(59);
2780 lprint"4"tab(69)"5":lprint linep$:return
2790 '--------------------------- EDIT STOCK RECORD ---------------------------
2800 EDITSTOCK:on error goto 7250
2810 clearw 2:?:plt%(0)=bkc(1):plt%(3)=bkd(1):poke a#,varptr(plt%(0))
2820 tl$=" EDIT STOCK RECORD ":gosub DOTITLE
2830 gotoxy 0,1:color 2,1,1:?" Q";:color 1,1,1:?" = Quit"tab(45);
2840 color 2,1,1:?"TAX";:color 1,1,1:?" = Edit Income TAX Rate"
2850 color 2,1,1:?" @";:color 1,1,1:?" = Restore Deleted Record"tab(45);
2860 color 2,1,1:?"&";:color 1,1,1:?" = Edit Closing Prices"
2870 gotoxy 0,4:line input"Enter Company Name or Stock Number ",stk$
2880 if len(stk$)=0 then stk$=stk1$
2890 gosub STOCKID:if stk$="Q" or stk$="q" then goto MAINMENU
2900 if stk$="TAX" or stk$="tax" then ta=1:sav=1:gosub DOTAX:goto EDITSTOCK
2910 if stk$="@" then goto UNDELETE
2920 if stk$="&" then goto EDITPRICE
2930 if hc>cnt or hc=0 then ?chr$(7);:goto EDITSTOCK
2940 get #1,hc:get #2,hc:get #4,hc
2950 if left$(name$,1)="*" then ?chr$(7);:goto EDITSTOCK
2960 fa=64:fl=1:clearw 2:gotoxy 0,0:?"Stock #"hc;tab(12);:color 2,1,1:?"Q";
2970 tb=42:color 1,1,1:?" = Quit"tab(tb);:color 2,1,1:?"*";:color 1,1,1
2980 ?" = DELETE RECORD":gotoxy 0,fl
2990 ?fl$;chr$(fa+fl)" Company NAME"tab(tb)name$:fl=fl+1
3000 ?fl$;chr$(fa+fl)" Listing Abbreviation"tab(tb)abbr$:fl=fl+1
3010 ?fl$;chr$(fa+fl)" Comments"tab(tb-21)comment$:fl=fl+1
3020 ?fl$;chr$(fa+fl)" Exchange"tab(tb)exch$:fl=fl+1
3030 ?fl$;chr$(fa+fl)" Rating"tab(tb)rate$:fl=fl+1
3040 ?fl$;chr$(fa+fl)" Current year HIGH"tab(tb)hi0$:fl=fl+1
3050 ?fl$;chr$(fa+fl)" Current year LOW"tab(tb)lo0$:fl=fl+1
3060 ?fl$;chr$(fa+fl)" Last year HIGH"tab(tb)hi1$:fl=fl+1
3070 ?fl$;chr$(fa+fl)" Last year LOW"tab(tb)lo1$:fl=fl+1
3080 ?fl$;chr$(fa+fl)" Two year ago HIGH"tab(tb)hi2$:fl=fl+1
3090 ?fl$;chr$(fa+fl)" Two year ago LOW"tab(tb)lo2$:fl=fl+1
3100 ?fl$;chr$(fa+fl)" Purchase Price Per Share"tab(tb)pch$:fl=fl+1
3110 ?fl$;chr$(fa+fl)" Number of SHARES"tab(tb)share$:fl=fl+1
3120 ?fl$;chr$(fa+fl)" Brokerage FEE ( .xx )"tab(tb)fee$:fl=fl+1
3130 ?fl$;chr$(fa+fl)" Do You Own This STOCK"tab(tb)own$:fl=fl+1
3140 ?fl$;chr$(fa+fl)" Date"tab(tb)date$
3150 mc=0:fx=0
3160 while mc=0:gotoxy 0,17
3170 color 2,1,1:?"Enter FIELD to EDIT ";:color 1,1,1:a=inp(2)
3180 if a >81 then a=a-32
3190 if a<65 or a>81 then ?chr$(7);:mc=0 else mc=1
3200 if a=81 then mc=1:fx=1
3210 if a=42 then mc=1:fx=2
3220 wend:if fx=1 then goto MAINMENU
3230 if fx=2 then gosub CHECKDEL:if a=-1 then goto EDITSTOCK else goto DOIT
3240 if a=65 then tb=31
3250 if a=67 then tb=13
3260 GEDIT:gotoxy (tb+5)/j,a-fa:line input n$:ne=val(n$)
3270 if len (n$)=0 then goto DOIT
3280 if a=65 and left$(n$,1)="*" then mid$(n$,1,1)="\"
3290 if (a>69 and a<=76) and (ne<lcut or ne>hcut) then ?chr$(7);:goto GEDIT
3300 if a=77 and (ne<1 or ne>hcut1) then ?chr$(7);:goto GEDIT
3310 if a=78 and (ne<=0 or ne>.99) then ?chr$(7);:goto GEDIT
3320 DOIT:on a-64 goto E1,E2,E3,E4,E5,E6,E7,E8,E9,E10,E11,E12,E13,E14,E15,E16
3330 E1:fln=1:if len(n$)=0 then n$=name$
3340 lset name$=n$:goto DOEDIT
3350 E2:fln=4:if len(n$)=0 then n$=abbr$
3360 lset abbr$=n$:goto DOEDIT
3370 E3:fln=4:if len(n$)=0 then n$=comment$
3380 lset comment$=n$:goto DOEDIT
3390 E4:fln=1:if len(n$)=0 then n$=exch$
3400 lset exch$=n$:goto DOEDIT
3410 E5:fln=1:if len(n$)=0 then n$=rate$
3420 lset rate$=n$:goto DOEDIT
3430 E6:fln=2:if len(n$)=0 then n$=hi0$
3440 lset hi0$=n$:goto DOEDIT
3450 E7:fln=2:if len(n$)=0 then n$=lo0$
3460 lset lo0$=n$:goto DOEDIT
3470 E8:fln=2:if len(n$)=0 then n$=hi1$
3480 lset hi1$=n$:goto DOEDIT
3490 E9:fln=2:if len(n$)=0 then n$=lo1$
3500 lset lo1$=n$:goto DOEDIT
3510 E10:fln=2:if len(n$)=0 then n$=hi2$
3520 lset hi2$=n$:goto DOEDIT
3530 E11:fln=2:if len(n$)=0 then n$=lo2$
3540 lset lo2$=n$:goto DOEDIT
3550 E12:fln=1:if len(n$)=0 then n$=pch$
3560 lset pch$=n$:goto DOEDIT
3570 E13:fln=1:if len(n$)=0 then n$=share$
3580 lset share$=n$:goto DOEDIT
3590 E14:fln=1:if len(n$)=0 then n$=fee$
3600 lset fee$=n$:goto DOEDIT
3610 E15:fln=4:if len(n$)=0 then n$=own$
3620 if n$="N" or n$="n" then n$="N" else n$="Y"
3630 lset own$=n$:goto DOEDIT
3640 E16:fln=4:if len(n$)=0 then n$=date$
3650 lset date$=n$
3660 DOEDIT:put #fln,hc:tb=42:stk1$=stk$:goto EDITSTOCK
3670 '---------------------------- DELETE RECORD ------------------------------
3680 CHECKDEL:
3690 n$="":mc=0:while mc=0:color 2,1,1:gotoxy 0,17
3700 ?chr$(7)"DELETE THIS RECORD ? ( Y / N ) "chr$(7);:ans=inp(2)
3710 if ans=89 or ans=121 then gosub DODELETE
3720 if ans=78 or ans=110 then a=-1:mc=1
3730 wend:?:if cnt1<1 then cnt1=1
3740 return
3750 DODELETE:
3760 a=65:cnt1=cnt1-1:sav=1:mc=1:n1$="*"+name$:n$=n1$:n1$="":return
3770 '------------------------ RESTORE DELETED RECORD -------------------------
3780 UNDELETE:
3790 an$="Enter Stock # ( Q = Quit ) "
3800 clearw 2:color 3,1,1:gotoxy 0,0
3810 plt%(0)=bkc(4):plt%(3)=bkd(4):poke a#,varptr(plt%(0))
3820 tl$=" RESTORE DELETED RECORD ":gosub DOTITLE
3830 mc1=2:gosub STOCKCH:if k1=1 then goto EDITSTOCK
3840 NXT5:color 3,1,1:gotoxy 0,vt:?an$;:line input ans$
3850 color 1,1,1:if ans$="Q" or ans$="q" then goto EDITSTOCK
3860 if len(ans$)=0 then ?chr$(7);:goto NXT5
3870 n=val(ans$):if n<1 or n>cnt-1 then ?chr$(7);:goto NXT5
3880 k2=1:for x=1 to k1-1:if n=ud(x) then k2=0
3890 next x:if k2=1 then k2=0:?chr$(7);:goto NXT5
3900 get #1,n
3910 cnt1=cnt1+1:sav=1:a=65:n1$=mid$(name$,2,len(name$)):n$=n1$:n1$=""
3920 hc=n:goto DOIT
3930 '--------------------------- USE EMPTY RECORDS ---------------------------
3940 CHECKSPACE:
3950 if fil=1 then return
3960 mc=0:hc=1:while mc=0
3970 get #1,hc
3980 if mid$(name$,1,1)="*" then mc=1:cn=hc else hc=hc+1
3990 if hc>=max then fil=1:mc=1
4000 wend:if cnt1>=max then cnt1=max:fil=1
4010 return
4020 '...................... SAVE RECORD TO REUSED SPACE ......................
4030 REUSE:
4040 put #1,cn:put #2,cn:put #4,cn:n$="0"
4050 rn=((cn-1)*250)+1:pt=pt(cn)-2:if pt<0 then pt=0
4060 for i=0 to pt:lset mo$=n$:lset price$=n$:put #3,rn+i:next i
4070 pt(cn)=0:pt1(cn)=0:cnt1=cnt1+1:return
4080 '--------------------------- EDIT CLOSING PRICE --------------------------
4090 EDITPRICE:on error goto 7250
4100 an$="Enter Record # ( Q = Quit C = Continue ) "
4110 clearw 2:color 1,1,1:gotoxy 0,0
4120 tl$=" EDIT MONTH / CLOSING PRICE ":gosub DOTITLE
4130 plt%(0)=bkc(8):plt%(3)=bkd(8):poke a#,varptr(plt%(0))
4140 EDTP:gotoxy 2,4:line input"Enter Company Name or Stock Number ",stk$
4150 if len(stk$)=0 then stk$=stk2$
4160 if len(stk$)=0 then goto EDITSTOCK
4170 gosub STOCKID:if hc>cnt or hc=0 then ?chr$(7);:goto EDTP
4180 get #1,hc:if pt(hc)=0 then ?" No Entries To Edit"chr$(7);:goto EDTP
4190 if left$(name$,1)="*" then ?chr$(7);:goto EDTP
4200 x=0:prb=pt(hc)-1:if prb=0 then prb=250
4210 tl$=" Closing Prices For "+name$+" "+str$(prb)+" Quotes "
4220 gosub DOTITLE:gosub DOED:wm=2:gosub WMODE
4230 pra=(hc-1)*250:mc=0:k=1:k2=1:for x=1 to pt1(hc)-1
4240 get #3,pra+x:st1(x)=val(mo$):st2(x)=val(price$):next x
4250 mc=0:x=1:while mc=0
4260 if mc=0 then color 2,1,1:?tab(dta(k2))x;tab(dta(k2+1));:color 1,1,1
4270 if mc=0 then ?st1(x)tab(dta(k2+2));:? using form$;st2(x)
4280 k=k+1:if k>10 then k=1:k2=k2+3:gotoxy 0,2
4290 if k2>12 then k2=1:k=1:gosub DOMESSAGE1
4300 x=x+1:if x>prb then mc=1
4310 wend:?:wm=1:gosub WMODE:if k2<>15 then gosub DOMESSAGE1
4320 k2=0:color 1,1,1
4330 if ans$="Q" or ans$="q" then stk2$="":goto EDITSTOCK
4340 get #3,pra+ans:color 3,1,1:gotoxy 0,13
4350 ?" REC = "ans;tab(16)"Month = "mo$tab(36)"Price = "price$" "
4360 color 1,1,1:?line$
4370 GETMO:gotoxy 8/j,15:line input"Enter Month ",n$:n=int(val(n$))
4380 if len(n$)=0 then ?chr$(7);:goto GETMO
4390 if n<1 or n>12 then ?chr$(7);:goto GETMO
4400 GETPR:gotoxy 26/j,15:line input "Enter Price ",n1$:n1=val(n1$)
4410 if len(n1$)=0 then ?chr$(7);:goto GETPR
4420 if n1<lcut or n1>hcut then ?chr$(7);:goto GETPR
4430 lset mo$=n$:lset price$=n1$:put #3,pra+ans
4440 stk2$=stk$:goto EDITSTOCK
4450 '......................... EDIT PRICE PROMPT ............................
4460 DOMESSAGE1:
4470 if kng<>0 then kng=0:?chr$(7);
4480 gotoxy 0,12:color 1,1,1:?line$
4490 gotoxy 0,13:color 2,1,1:?an$;:line input ans$:ans=val(ans$)
4500 if ans$="Q" or ans$="q" then mc=1:k2=15:goto MESSDONE
4510 if ans$="C" or ans$="c" then gosub DOED:if kng=1 then goto DOMESSAGE1
4520 if ans$="C" or ans$="c" then wm=2:gosub WMODE:return
4530 if len(ans$)=0 or (ans<1 or ans>prb) then ?chr$(7);:goto DOMESSAGE1
4540 MESSDONE:color 1,1,1:mc=1:k2=15:kng=0:return
4550 '............................ DO HEADER ..................................
4560 DOED:if x+1>prb then kng=1:return
4570 clearw 2:gotoxy 0,0:color 3,1,1
4580 ?" REC MO PRICE"tab(20)"REC MO PRICE"tab(38);
4590 ?"REC MO PRICE"tab(56)"REC MO PRICE":color 1,1,1
4600 ?line$:gotoxy 0,2:return
4610 '-------------------- DISPLAY DATA SHEET & CHART -------------------------
4620 DISPLAY:
4630 drc1=0:on error goto 7250
4640 an$="Enter Stock # ( Q = Quit ) "
4650 clearw 2:drc=0:tl$=" DATA SHEET & CHART ":gosub DOTITLE
4660 gotoxy 0,vt:?"Enter Stock # ( ";:color 3,1,1:?"RETURN";:color 1,1,1
4670 ?" = List Stocks ) ";:line input n$:if len(n$)>0 then goto NXT6A
4680 mc1=1:color 3,1,1:gotoxy 0,0:gosub STOCKCH
4690 NXT6:color 1,1,1:gotoxy 0,vt:?an$;:line input n$
4700 NXT6A:color 1,1,1:if n$="Q" or n$="q" then goto MAINMENU
4710 if len(n$)=0 then ?chr$(7);:goto NXT6
4720 n=val(n$):if n<1 or n>cnt-1 then ?chr$(7);:goto NXT6
4730 for x=1 to k1-1:if ud(x)=n then k2=1
4740 next x:if k2=1 then k2=0:?chr$(7);:goto NXT6
4750 clearw 2:get #1,n:get #2,n:get #4,n:goto DODATASHEET
4760 '...................... DISPLAY STOCK CHOICES ...........................
4770 STOCKCH:
4780 wm=2:gosub WMODE
4790 ?"STK#"tab(7)"STOCK NAME"tab(20)"STK#"tab(26)"STOCK NAME"tab(39);
4800 ?"STK#"tab(45)"STOCK NAME"tab(58)"STK#"tab(64)"STOCK NAME"
4810 color 1,1,1:?line$:gotoxy 0,2
4820 i=0:mc=0:k=1:k1=1:k2=1:while mc=0:gosub GETDISPLAY
4830 if mc=0 then color 2,1,1:?tab(dtb(k2))i;tab(dtb(k2+1));:color 1,1,1
4840 if mc=0 then ?abbr$:k=k+1
4850 if k>13 then k=1:k2=k2+2:gotoxy 0,2
4860 wend:?:wm=1:gosub WMODE:k2=0:return
4870 '......................... GET STOCK TO DISPLAY .........................
4880 GETDISPLAY:i=i+1:if i>cnt-1 then mc=1:return
4890 get #1,i:get #4,i
4900 if mc1=1 and left$(name$,1)="*" then ud(k1)=i:k1=k1+1:goto GETDISPLAY
4910 if mc1=2 and left$(name$,1)<>"*" then goto GETDISPLAY
4920 if mc1=2 and left$(name$,1)="*" then ud(k1)=i:k1=k1+1
4930 return
4940 '......................... DISPLAY DATA SHEET ...........................
4950 DODATASHEET:
4960 if pt(n)=0 then goto MAINMENU
4970 tl$=" Data Sheet For "+name$+" Stock # "+str$(n)+" "
4980 gosub DOTITLE:pa=pt(n)-1:if pa<1 then pa=250
4990 clearw 2:color 3,1,1:gotoxy 0,0:gosub DOCALC
5000 br8$="-Most Recent":if own$="Y" and drc1=0 then gosub DOSOUND
5010 plt%(0)=0:plt%(3)=1911:plt%(2)=112:poke a#,varptr(plt%(0))
5020 ?"Name";:color 1,1,1:?tab(7)name$tab(29);
5030 color 3,1,1:?"Listed As";:color 1,1,1:?tab(45)abbr$tab(58);
5040 color 3,1,1:?"Exchange";:color 1,1,1:?tab(68)exch$
5050 color 3,1,1:?"Date";:color 1,1,1:?tab(7)date$tab(29);
5060 color 3,1,1:?"Purchase Price";:color 1,1,1:print using form$;tab(45)pch;
5070 color 3,1,1:?tab(58)"Rating";:color 1,1,1:?tab(68)rate$
5080 color 3,1,1:?"Average Hi";:color 1,1,1:print using form$;tab(13)hi;
5090 color 3,1,1:?tab(29)"Average Lo";:color 1,1,1:print using form$;tab(45)lo;
5100 color 3,1,1:?tab(58)"Owned"tab(68);:color 1,1,1:?own$
5110 color 3,1,1:?"Comments"tab(10);:color 1,1,1:?comment$tab(58);:color 3,1,1
5120 ?"Quotes "tab(67);:color 1,1,1:?pa:?line$
5130 ?share;tab(10);:color 1,1,1
5140 ?"Shares Purchased At "tab(35);:print using form$;pch;:color 3,1,1
5150 print using form2$;tab(50)pch*share:color 1,1,1
5160 ?tab(10)"Brokerage Fee"tab(36);:print using form1$;f*100tab(49);
5170 color 3,1,1:print using form2$;fee
5180 color 1,1,1:?tab(10)"Total Purchase Price"tab(50);:color 3,1,1
5190 print using form2$;s2:color 1,1,1:?line1$
5200 ?"If Sold At Last Quote of"tab(35);:print using form$;st2(x-1)tab(50);
5210 color ec,1,1:print using form2$;s1:color 1,1,1
5220 ?"This Represents a";:color ec,1,1:?b$;:color 1,1,1:?" of"tab(36);
5230 color ec,1,1:print using form1$;pc;tab(49);
5240 print using form2$;pf:color 1,1,1:?line1$
5250 if b$=" LOSS" or b$=" BREAK EVEN" then sc=1:drc1=1:goto MENUBAR
5260 sc=1:drc1=1:?"TAX RATE = ";:print using form1$;tax*100
5270 ?"Long Term TAX"tab(18);:color 2,1,1:print using form2$;lt;
5280 color 1,1,1:?tab(43)"Profit ";:color 3,1,1:print using form2$;pf-lt
5290 color 1,1,1:?"Short Term TAX"tab(18);:color 2,1,1:print using form2$;st;
5300 color 1,1,1:?tab(43)"Profit ";:color 3,1,1:print using form2$;pf-st
5310 '.................. DATA SHEET / CHART MENU BAR .........................
5320 MENUBAR:
5330 if sc=1 then cl$=" ":r4$="L":br4$="-List To Printer":r7$=""
5340 if sc=1 then br3$="-Display Chart":r5$="":br5$="":br7$=""
5350 if sc=2 then cl$=" ":r4$="C":br4$="-Color":br3$="-Data":r7$="R"
5360 if sc=2 then r5$="Alt+HELP":br5$="-To Printer ":br7$=br8$
5370 color 2,1,1:gotoxy 0,vt:?"N";:color 1,1,1:?br1$;cl$;
5380 color 2,1,1:?"P";:color 1,1,1:?br2$;cl$;:color 2,1,1
5390 ?"D";:color 1,1,1:?br3$;cl$;:color 2,1,1:?r4$;:color 1,1,1
5400 ?br4$;cl$;:color 2,1,1:?r7$;:color 1,1,1:?br7$;cl$;
5410 color 2,1,1:?r5$;:color 1,1,1:?br5$;:color 2,1,1
5420 ?"Q";:color 1,1,1:?br6$
5430 a=inp(2):if a=81 or a=113 then goto MAINMENU
5440 if a=78 or a=110 then goto DONEXT
5450 if a=80 or a=112 then goto DOPREV
5460 if (a=76 or a=108) and sc=1 then goto PRINTDATASHEET
5470 if (a=68 or a=100) and sc=1 and drc2=1 then goto DOCHRT
5480 if (a=68 or a=100) and sc=1 then goto DOCHART
5490 if (a=68 or a=100) and sc=2 and drc=1 then openw 2:drc=0:goto DODATASHEET
5500 if (a=68 or a=100) and sc=2 then goto DODATASHEET
5510 if (a=67 or a=99) and sc=2 then gosub BACKG:goto MENUBAR
5520 if (a=82 or a=114) and sc=2 then goto DORECENT
5530 ?chr$(7);:goto MENUBAR
5540 DONEXT:drc=0:drc1=0:drc2=0:br8$="-Most Recent":n=n+1:if n>cnt-1 then n=1
5550 get #1,n:get #2,n:get #4,n:if left$(name$,1)="*" then goto DONEXT
5560 if pt(n)=0 then goto DONEXT
5570 if sc=1 then goto DODATASHEET else gosub DOCALC:goto DOCHART
5580 DOPREV:drc=0:drc1=0:drc2=0:br8$="-Most Recent":n=n-1:if n<1 then n=cnt-1
5590 get #1,n:get #2,n:get #4,n:if left$(name$,1)="*" then goto DOPREV
5600 if pt(n)=0 then goto DOPREV
5610 if sc=1 then goto DODATASHEET else gosub DOCALC:goto DOCHART
5620 DOCHRT:
5630 plt%(0)=bka:plt%(2)=bka2:plt%(3)=bka1:poke a#,varptr(plt%(0)):openw 2
5640 sc=2:tl$=" Preformance Chart For "+name$+" "+str$(pa1)+" Quotes "
5650 gosub DOTITLE:goto MENUBAR
5660 '....................... TOGGLE BACKGROUND COLOR ........................
5670 BACKG:swap bka,bkb:swap bka1,bkb1:swap bka2,bkb2
5680 plt%(0)=bka:plt%(2)=bka2:plt%(3)=bka1:poke a#,varptr(plt%(0)):return
5690 '....................... CALC MOST RECENT QUOTES ........................
5700 DORECENT:
5710 if drc=1 then drc=0:br8$="-Most Recent":goto DOCHRT
5720 drc=1:br8$="-Full Chart ":pb=pt(n)-1:if pb<1 then pb=250
5730 pc=pb:mc=0:while mc=0
5740 pc=pc-1:if pc<1 then pc=1:mc=1
5750 if st1(pc)<>st1(pb) then mc=1
5760 wend:pa=(pb-pc)+1:pd=pa:goto DOCHART1
5770 '.......................... DO CALCULATIONS .............................
5780 DOCALC:
5790 p1=0:p2=9999:for x=1 to pt1(n)-1:get #3,((n-1)*250)+x
5800 st1(x)=val(mo$):st2(x)=val(price$):if st2(x)>p1 then p1=st2(x)
5810 if st2(x)<p2 then p2=st2(x)
5820 next x:if p2<lcut then p2=lcut
5830 if p1>hcut then p1=hcut
5840 pch=val(pch$):share=val(share$):f=val(fee$):fee=f*(share*pch)
5850 s1=st2(x-1)*share:s2=fee+(pch*share)
5860 if s1<s2 then ec=2:b$=" LOSS":pf=s2-s1 else ec=3:b$=" GAIN":pf=s1-s2
5870 if s1=s2 then b$=" BREAK EVEN":ec=2:pf=0
5880 pc=(pf/s2)*100:lt=(pf*.4)*tax:st=pf*tax
5890 hi=(val(hi0$)+val(hi1$)+val(hi2$))/3:if hi<=1 then hi=p1
5900 lo=(val(lo0$)+val(lo1$)+val(lo2$))/3:if lo<=1 then lo=p2
5910 return
5920 '...................... LIST DATA SHEET TO PRINTER .......................
5930 PRINTDATASHEET:
5940 lprint tab(22)"DATA SHEET FOR "name$:lprint
5950 lprint"Name"tab(7)name$tab(29)"Listed As"tab(45)abbr$tab(58);
5960 lprint"Exchange"tab(68)exch$:lprint"Date"tab(7)date$tab(29);
5970 lprint"Purchase Price";:lprint using form$;tab(45)pch;
5980 lprint tab(58)"Rating"tab(68)rate$
5990 lprint"Average Hi";:lprint using form$;tab(13)hi;
6000 lprint tab(29)"Average Lo";:lprint using form$;tab(45)lo;
6010 lprint tab(58)"Owned"tab(68)own$:lprint"Comments"tab(10)comment$tab(58);
6020 lprint"Quotes "tab(67)pa:lprint linep$
6030 lprint share;tab(10)"Shares Purchased At "tab(35);:lprint using form$;pch;
6040 lprint using form2$;tab(50)pch*share
6050 lprint tab(10)"Brokerage Fee"tab(37);:lprint using form1$;f*100tab(50);
6060 lprint using form2$;fee:lprint tab(10)"Total Purchase Price"tab(50);
6070 lprint using form2$;s2:lprint linep$
6080 lprint"If Sold At Last Quote of"tab(35);
6090 lprint using form$;st2(x-1)tab(50);
6100 lprint using form2$;s1:lprint"This Represents a"b$" of"tab(37);
6110 lprint using form1$;pc;tab(50);
6120 lprint using form2$;pf:lprint linep$
6130 if b$=" LOSS" or b$=" BREAK EVEN" then lf=50:goto FORMF
6140 lprint"TAX RATE = ";:lprint using form1$;tax*100
6150 lprint"Long Term TAX"tab(18);:lprint using form2$;lt;
6160 lprint tab(43)"Profit ";:lprint using form2$;pf-lt
6170 lprint"Short Term TAX"tab(18);:lprint using form2$;st;
6180 lprint tab(43)"Profit ";:lprint using form2$;pf-st:lf=47
6190 FORMF:?chr$(7);:for i=1 to lf:lprint:next i:goto MENUBAR
6200 '............................. DO CHART .................................
6210 DOCHART:
6220 pc=1:pb=pt1(n)-1:pd=pb:pa=pt(n)-1:pa1=pa:if pa<1 then pa=250:pa1=250
6230 DOCHART1:if pt(n)=0 then goto MAINMENU
6240 tl$=" Performance Chart For "+name$+" "+str$(pa)+" Quotes "
6250 clearw 2:gosub DOTITLE
6260 if own$="Y" and drc1=0 then gosub DOSOUND
6270 plt%(0)=bka:plt%(2)=bka2:plt%(3)=bka1:poke a#,varptr(plt%(0))
6280 ss=0:for i=pc to pb:ss=ss+st2(i):next i:ss=int(ss/pd)
6290 color 1,1,1:ss=ss-7:if ss<1 then ss=0
6300 s7=ss:linet=3:gosub LINETYPE:poke contrl,8:poke contrl+2,1
6310 for x=cr to cr*14 step cr:linef 30,cr1-x,606,cr1-x
6320 ss$=str$(ss):poke contrl+6,len(ss$)-1
6330 for i=0 to len(ss$)-2:poke intin+(i*2),val(mid$(ss$,2+i,1))+48:next i
6340 poke ptsin,3:poke ptsin+2,cr2-x:vdisys(1):ss=ss+1:next x
6350 linet=2:gosub LINETYPE:if int(hi)<s7 then gosub HSHL:hs=1:goto DOLO
6360 if int(hi)>s7+13 then gosub HSHH:hs=2:goto DOLO
6370 d1=hi:px=30:px1=606:gosub GETY:color 3,1,3:linef px,py,px1,py
6380 wl=2:hs1=72:hs2=105:vp=cr2-(cr1-py):gosub HSOUT
6390 DOLO:if int(lo)<s7 then gosub HSLL:goto DOPCH
6400 if int(lo)>s7+13 then gosub HSLH:goto DOPCH
6410 hs=0:d1=lo:px=30:px1=606:gosub GETY:color 2,1,2:linef px,py,px1,py
6420 wl=2:hs1=76:hs2=111:vp=cr2-(cr1-py):gosub HSOUT
6430 DOPCH:if int(pch)<s7 or int(pch)>s7+13 then goto DOLINES
6440 linet=4:gosub LINETYPE
6450 d1=pch:px=30:px1=606:gosub GETY:color 1,1,1:linef px,py,px1,py
6460 wl=3:hs1=80:hs2=99:hs3=104:vp=cr2-(cr1-py):gosub HSOUT
6470 DOLINES:
6480 if pb<2 then sc=2:goto MENUBAR
6490 linet=1:gosub LINETYPE
6500 x1=576/pd:x2=30:x3=1:d1=st2(pc):gosub GETY:p1=py
6510 for x=pc+1 to pb:d1=st2(x):gosub GETY:p2=py
6520 if st2(x)>=pch+(pch*f) then color 1,1,3 else color 1,1,2
6530 linef x2,p1,x2+x1,p2:x3=x3+1
6540 if st1(x)<>st1(x-1) then gosub DOMONTH
6550 p1=p2:x2=x2+x1:next x:gosub DOMONTH1
6560 if drc2=0 then drc2=1:reset
6570 sc=2:drc1=1:goto MENUBAR
6580 '......................... CALCULATE Y COORDINATE .......................
6590 GETY:
6600 py=int(d1):py1=int((d1-py)*10)*syt:if py<s7 then py=s7:py1=0
6610 if py>s7+13 then py=s7+13:py1=0
6620 py=(cr1-cr)-((py-s7)*cr)-py1:return
6630 '........................ DRAW VERTICAL MONTH LINE ......................
6640 DOMONTH:
6650 color 1,1,1:linef x2,0,x2,cr1-10*syt
6660 DOMONTH1:th=dh:gosub THEIGHT
6670 poke contrl,8:poke contrl+2,1:poke contrl+6,3:ms=(((st1(x-1))-1)*3)+1
6680 poke intin,mnt(ms):poke intin+2,mnt(ms+1):poke intin+4,mnt(ms+2)
6690 x4=x2-((x1*x3)/2):if x4<40 then x4=15
6700 poke ptsin,x4:poke ptsin+2,cr+(vh*syt):vdisys(1)
6710 x3=1:th=dth:gosub THEIGHT:return
6720 '............................. DO LO MARKERS ............................
6730 HSHL:wl=3:hs1=72:hs2=2:hs3=32:vp=cr2-cr:color 3,1,1:gosub HSOUT:return
6740 HSHH:wl=3:hs1=72:hs2=1:hs3=32:vp=cr2-(cr*14):color 3,1,1
6750 gosub HSOUT:return
6760 HSLL:wl=3:hst=1:hs1=32:hs2=2:hs3=76:vp=cr2-cr:color 2,1,1:gosub HSOUT
6770 color 1,1,1:if hs=1 then hs3=32:gosub HSOUT
6780 hs=0:hst=0:return
6790 HSLH:wl=3:hst=2:hs1=32:hs2=1:hs3=76:vp=cr2-(cr*14):color 2,1,1
6800 gosub HSOUT:color 1,1,1:if hs=2 then hs3=32:gosub HSOUT
6810 hs=0:hst=0:return
6820 '......................... PRINT HI / LO MARKER .........................
6830 HSOUT:
6840 if (hs=1 and hst=1) or (hs=2 and hst=2) then wm=2:gosub WMODE
6850 poke contrl,8:poke contrl+2,1:poke contrl+6,wl
6860 poke intin,hs1:poke intin+2,hs2:poke intin+4,hs3
6870 poke ptsin,3:poke ptsin+2,vp:vdisys(1)
6880 if (hs=1 and hst=1) or (hs=2 and hst=2) then wm=1:gosub WMODE
6890 return
6900 '--------------------------- GET TAX BRACKET -----------------------------
6910 DOTAX:restore TAXTABLE
6920 clearw 2:sav=1:a$="Schedule ":tl$=" YOUR TAX BRACKET ":gosub DOTITLE
6930 plt%(0)=bkc(6):plt%(3)=bkd(6):poke a#,varptr(plt%(0))
6940 color 1,1,1:gotoxy 0,0:?"Enter the rate that most closely applies"
6950 ?:?"Single"tab(20)"Joint"tab(39)"Separate"tab(57)"Head House"
6960 ?a$"X"tab(13);:color 2,1,1:?"RATE"tab(20);:color 1,1,1:?a$"Y"tab(32);
6970 color 2,1,1:?"RATE"tab(39);:color 1,1,1:?a$"Y"tab(51);:color 2,1,1
6980 ?"RATE"tab(57);:color 1,1,1:?a$"Z"tab(71);:color 2,1,1:?"RATE"
6990 color 1,1,1:?line$
7000 for i=1 to 10:read a$,b$,c$,d$,e$,f$,g$,h$,i$,j$,k$,l$
7010 ?a$"-"b$;tab(14);:color 2,1,1:?c$;tab(20);:color 1,1,1:?d$"-"e$;tab(33);
7020 color 2,1,1:?f$;tab(39);:color 1,1,1:?g$"-"h$;tab(51);:color 2,1,1
7030 ?i$;tab(57);:color 1,1,1:?j$"-"k$;tab(72);:color 2,1,1:?l$:color 1,1,1
7040 next x:color 2,1,1:mc=0:while mc=0
7050 gotoxy 0,16:line input"Enter TAX RATE ",n$:tax=val(n$)
7060 color 1,1,1:if tax<=0 or tax>=1 then ?chr$(7);:mc=0 else mc=1
7070 wend:if ta=1 then ta=0:return
7080 '------------------------- DISK INITIALIZATION --------------------------
7090 close #1:tl$=" DISK INITIALIZATION ":gosub DOTITLE:clearw 2
7100 plt%(0)=1792:plt%(3)=0:poke a#,varptr(plt%(0)):?chr$(7)
7110 gotoxy 10/j,0:?"Stock Performance Tracker creates files that require"
7120 gotoxy 10/j,2:?"an entire single sided disk. The only files this disk"
7130 gotoxy 10/j,4:?"should contain at this time are BASIC.PRG, BASIC.RSC"
7140 gotoxy 10/j,6:?"and this program ( STOCKS.BAS ).":color 3,1,1
7150 gotoxy 10/j,8:?"THE ONLY TIME YOU SHOULD SEE THIS MESSAGE, IS THE VERY"
7160 gotoxy 10/j,10:?"FIRST TIME YOU RUN THIS PROGRAM. IF YOU SEE THIS"
7170 gotoxy 10/J,12:?"MESSAGE AT ANY OTHER TIME, SOMETHING IS WRONG."
7180 gotoxy 10/j,14:color 1,1,1
7190 ?"Time Required to Initialize Disk = 2 Min. 50 Sec."
7200 gotoxy 10/j,16:?"Press I to Initialize Disk. Any Other Key Will ABORT"
7210 ans=inp(2):if ans=73 or ans=105 then goto DODISK else resume CLEAN
7220 DODISK:f$="price.dat":open "R",#1,f$,8:field #1, 2 as a$,6 as b$:c$="0"
7230 for x=1 to 12500:lset a$=c$:lset b$=c$:put #1:next x:close #1:?chr$(7);
7240 resume GETDAT
7250 resume MAINMENU
7260 hc=cnt+1:resume GETOUT
7270 '---------------------------- IDENTIFY STOCK -----------------------------
7280 STOCKID:
7290 hc=val(stk$):if len(stk$)=0 then hc=cnt+1
7300 if hc=0 and len(stk$)>=1 then gosub DONAMEST
7310 return
7320 '...................... GET STOCK I.D. BY NAME ..........................
7330 DONAMEST:on error goto 7260
7340 if stk$="TAX" or stk$="tax" or stk$="@" or stk$="&" then stk1$=stk$:return
7350 mc=0:hc=1:while mc=0
7360 get #1,hc
7370 if mid$(name$,1,len(stk$))=stk$ then mc=1 else hc=hc+1
7380 GETOUT:if hc>cnt then mc=1
7390 wend:return
7400 '--------------------------- CLEAN-UP AND END ----------------------------
7410 CLEANUP:
7420 close #1:close #2:close #3:close #4
7430 if sav=0 then goto CLEAN
7440 f$="index.dat":open "O",#1,f$:write #1,tax,cnt,cnt1
7450 for x=1 to 50:write #1,pt(x),pt1(x):next x:close #1
7460 CLEAN:plt%(0)=1911:plt%(1)=1792:plt%(2)=112:plt%(3)=0
7470 poke a#,varptr(plt%(0)):color 1,1,1
7480 clearw 2:?chr$(7);chr$(7);:clear:end
7490 '---------------------------- POLYLINE TYPE ------------------------------
7500 LINETYPE:
7510 poke contrl,15:poke contrl+2,0:poke contrl+6,1
7520 poke intin,linet:vdisys(1):return
7530 '----------------------------- TEXT HEIGHT ------------------------------
7540 THEIGHT:
7550 poke contrl,107:poke contrl+2,0:poke contrl+6,1
7560 poke intin,th:vdisys(1):return
7570 '----------------------------- TEXT EFFECTS -----------------------------
7580 TEFFECT:
7590 poke contrl,106:poke contrl+2,0:poke contrl+6,1
7600 poke intin,te:vdisys(1):return
7610 '------------------------------ WRITE MODE ------------------------------
7620 WMODE:
7630 poke contrl,32:poke contrl+2,0:poke contrl+6,1
7640 poke intin,wm:vdisys(2):return
7650 '------------------------- DO STOCK OWNED SOUND -------------------------
7660 DOSOUND:
7670 sound 1,0,9,5,0:wave 1,1,8,512,0:for i=1 to 125:next i
7680 sound 0,0,0,0,0:wave 0,0,0,0,0:return
7690 '---------------------------- PROGRAM DATA ------------------------------
7700 TAXTABLE:
7710 data 11000,13000,.18,16000,21000,.18,8000,10000,.18,12000,15000,.18
7720 data 13000,15000,.2,21000,25000,.22,10000,12000,.22,15000,18000,.2
7730 data 15000,18000,.23,25000,31000,.25,12000,15000,.25,18000,24000,.24
7740 data 18000,24000,.26,31000,36000,.28,15000,18000,.28,24000,29000,.28
7750 data 24000,29000,.3,36000,47000,.33,18000,23000,.33,29000,35000,.32
7760 data 29000,35000,.34,47000,62000,.42,23000,31000,.38,35000,46000,.35
7770 data 35000,43000,.38,62000,89000,.42,31000,44000,.42,46000,63000,.42
7780 data 43000,57000,.42,89000,113000,.45,44000,56000,.45,63000,85000,.45
7790 data 57000,85000,.48,113000,169000,.49,56000,84000,.49,85000,112000,.48
7800 data 85000,-----,.5,169000,------,.5,84000,-----,.5,112000,------,.5
7810 MEDREZ:
7820 data 1,10,150,175,1,16,9,7,18
7830 data 546,119,1365,0,3,119,70,0,2,119,32,96,3,119,48,1911
7840 HIREZ:
7850 data 1.8,20,303,348,2,17,12,9,15
7860 data 1911,0,1911,0,1911,0,1911,0,0,1911,1911,0,0,1911,0,1911
7870 MTEXT:
7880 data 74,97,110,70,101,98,77,97,114,65,112,114,77,97,121,74,117,110
7890 data 74,117,108,65,117,103,83,101,112,79,99,116,78,111,118,68,101,99
7900 TITLEDAT:
7910 data 83,84,79,67,75
7920 data 80,69,82,70,79,82,77,65,78,67,69
7930 data 84,82,65,67,75,69,82
7940 TABSETTINGS:
7950 data 1,7,20,26,39,45,58,64
7960 data 0,6,10,19,24,28,37,42,46,55,60,64
ə
